home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / mac / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectPlay / Conferencer / frmWhiteBoard.frm < prev    next >
Text File  |  2001-10-08  |  9KB  |  254 lines
  1. VERSION 5.00
  2. Begin VB.Form frmWhiteBoard 
  3.    Caption         =   "Whiteboard"
  4.    ClientHeight    =   7200
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   9600
  8.    Icon            =   "frmWhiteBoard.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   7200
  11.    ScaleWidth      =   9600
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.PictureBox picDraw 
  14.       AutoRedraw      =   -1  'True
  15.       BackColor       =   &H00FFFFFF&
  16.       Height          =   7155
  17.       Left            =   0
  18.       ScaleHeight     =   7095
  19.       ScaleWidth      =   9495
  20.       TabIndex        =   0
  21.       Top             =   0
  22.       Width           =   9555
  23.    End
  24.    Begin VB.Menu Pop 
  25.       Caption         =   "mnuPop"
  26.       Visible         =   0   'False
  27.       Begin VB.Menu mnuRed 
  28.          Caption         =   "Draw with Red"
  29.       End
  30.       Begin VB.Menu mnuBlue 
  31.          Caption         =   "Draw with Blue"
  32.       End
  33.       Begin VB.Menu mnuGreen 
  34.          Caption         =   "Draw with Green"
  35.       End
  36.       Begin VB.Menu mnuGrey 
  37.          Caption         =   "Draw with Grey"
  38.       End
  39.       Begin VB.Menu mnuPurp 
  40.          Caption         =   "Draw with Purple"
  41.       End
  42.       Begin VB.Menu mnuYellow 
  43.          Caption         =   "Draw with Yellow"
  44.       End
  45.       Begin VB.Menu mnuSep 
  46.          Caption         =   "-"
  47.       End
  48.       Begin VB.Menu mnuClear 
  49.          Caption         =   "Clear Board"
  50.       End
  51.    End
  52. End
  53. Attribute VB_Name = "frmWhiteBoard"
  54. Attribute VB_GlobalNameSpace = False
  55. Attribute VB_Creatable = False
  56. Attribute VB_PredeclaredId = True
  57. Attribute VB_Exposed = False
  58. Option Explicit
  59. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  60. '
  61. '  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  62. '
  63. '  File:       frmWhiteBoard.frm
  64. '
  65. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  66. Implements DirectPlay8Event
  67. Private mlColor As Long
  68. Private mlLastX As Single: Private mlLastY As Single
  69.  
  70. Private Sub Form_Resize()
  71.     picDraw.Move 0, 0, Me.Width, Me.Height
  72. End Sub
  73.  
  74. Private Sub mnuBlue_Click()
  75.     mlColor = RGB(0, 0, 255)
  76. End Sub
  77.  
  78. Private Sub mnuClear_Click()
  79.     Dim lMsg As Long, lOffset As Long
  80.     Dim oBuf() As Byte
  81.     picDraw.Cls
  82.     'Send the clear msg
  83.     lOffset = NewBuffer(oBuf)
  84.     lMsg = MsgClearWhiteBoard
  85.     AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
  86.     dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_NOLOOPBACK
  87. End Sub
  88.  
  89. Private Sub mnuGreen_Click()
  90.     mlColor = RGB(0, 255, 0)
  91. End Sub
  92.  
  93. Private Sub mnuGrey_Click()
  94.     mlColor = RGB(128, 128, 128)
  95. End Sub
  96.  
  97. Private Sub mnuPurp_Click()
  98.     mlColor = RGB(156, 56, 167)
  99. End Sub
  100.  
  101. Private Sub mnuRed_Click()
  102.     mlColor = RGB(255, 0, 0)
  103. End Sub
  104.  
  105. Private Sub mnuYellow_Click()
  106.     mlColor = RGB(255, 255, 0)
  107. End Sub
  108.  
  109. Private Sub picDraw_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  110.     Dim lMsg As Long, lOffset As Long
  111.     Dim oBuf() As Byte
  112.     If Button = vbLeftButton Then 'We are drawing
  113.         If mlColor = 0 Then mlColor = RGB(255, 0, 0)
  114.         'First draw the dot
  115.         picDraw.PSet (X, Y), mlColor
  116.         'Now tell everyone about it
  117.         
  118.         'Now let's send a message to draw this dot
  119.         lOffset = NewBuffer(oBuf)
  120.         lMsg = MsgSendDrawPixel
  121.         AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
  122.         AddDataToBuffer oBuf, mlColor, LenB(mlColor), lOffset
  123.         AddDataToBuffer oBuf, X, SIZE_SINGLE, lOffset
  124.         AddDataToBuffer oBuf, Y, SIZE_SINGLE, lOffset
  125.         dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_NOLOOPBACK
  126.         'Now store the last x/y
  127.         mlLastX = X: mlLastY = Y
  128.     End If
  129. End Sub
  130.  
  131. Private Sub picDraw_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  132.     Dim lMsg As Long, lOffset As Long
  133.     Dim oBuf() As Byte
  134.     If Button = vbLeftButton Then 'We are drawing
  135.         If mlColor = 0 Then mlColor = RGB(255, 0, 0)
  136.         'First draw the dot
  137.         picDraw.Line (mlLastX, mlLastY)-(X, Y), mlColor
  138.         'Now tell everyone about it
  139.         
  140.         'Now let's send a message to draw this line
  141.         lOffset = NewBuffer(oBuf)
  142.         lMsg = MsgSendDrawLine
  143.         AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
  144.         AddDataToBuffer oBuf, mlColor, LenB(mlColor), lOffset
  145.         AddDataToBuffer oBuf, mlLastX, SIZE_SINGLE, lOffset
  146.         AddDataToBuffer oBuf, mlLastY, SIZE_SINGLE, lOffset
  147.         AddDataToBuffer oBuf, X, SIZE_SINGLE, lOffset
  148.         AddDataToBuffer oBuf, Y, SIZE_SINGLE, lOffset
  149.         dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_NOLOOPBACK
  150.         'Now store the last x/y
  151.         mlLastX = X: mlLastY = Y
  152.     End If
  153. End Sub
  154.  
  155. Private Sub picDraw_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  156.     If Button = vbRightButton Then
  157.         PopupMenu Pop
  158.     End If
  159. End Sub
  160.  
  161. Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
  162.     'VB requires that we must implement *every* member of this interface
  163. End Sub
  164.  
  165. Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
  166.     'VB requires that we must implement *every* member of this interface
  167. End Sub
  168.  
  169. Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
  170.     'VB requires that we must implement *every* member of this interface
  171. End Sub
  172.  
  173. Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
  174.     'VB requires that we must implement *every* member of this interface
  175. End Sub
  176.  
  177. Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean)
  178.     'VB requires that we must implement *every* member of this interface
  179. End Sub
  180.  
  181. Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean)
  182.     'VB requires that we must implement *every* member of this interface
  183. End Sub
  184.  
  185. Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
  186.     'VB requires that we must implement *every* member of this interface
  187. End Sub
  188.  
  189. Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
  190.     'VB requires that we must implement *every* member of this interface
  191. End Sub
  192.  
  193. Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean)
  194.     'VB requires that we must implement *every* member of this interface
  195. End Sub
  196.  
  197. Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
  198.     'VB requires that we must implement *every* member of this interface
  199. End Sub
  200.  
  201. Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean)
  202.     'VB requires that we must implement *every* member of this interface
  203. End Sub
  204.  
  205. Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean)
  206.     'VB requires that we must implement *every* member of this interface
  207. End Sub
  208.  
  209. Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean)
  210.     'VB requires that we must implement *every* member of this interface
  211. End Sub
  212.  
  213. Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean)
  214.     'VB requires that we must implement *every* member of this interface
  215. End Sub
  216.  
  217. Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
  218.     'All we care about in this form is what msgs we receive.
  219.     Dim lMsg As Long, lOffset As Long
  220.     Dim lColor As Long
  221.     Dim lX As Single, lY As Single
  222.     Dim lX1 As Single, lY1 As Single
  223.     
  224.     With dpnotify
  225.     GetDataFromBuffer .ReceivedData, lMsg, LenB(lMsg), lOffset
  226.     Select Case lMsg
  227.     Case MsgSendDrawPixel
  228.         GetDataFromBuffer .ReceivedData, lColor, LenB(lColor), lOffset
  229.         GetDataFromBuffer .ReceivedData, lX, LenB(lX), lOffset
  230.         GetDataFromBuffer .ReceivedData, lY, LenB(lY), lOffset
  231.         On Error Resume Next
  232.         picDraw.PSet (lX, lY), lColor
  233.     Case MsgSendDrawLine
  234.         GetDataFromBuffer .ReceivedData, lColor, LenB(lColor), lOffset
  235.         GetDataFromBuffer .ReceivedData, lX, LenB(lX), lOffset
  236.         GetDataFromBuffer .ReceivedData, lY, LenB(lY), lOffset
  237.         GetDataFromBuffer .ReceivedData, lX1, LenB(lX), lOffset
  238.         GetDataFromBuffer .ReceivedData, lY1, LenB(lY), lOffset
  239.         On Error Resume Next
  240.         picDraw.Line (lX, lY)-(lX1, lY1), lColor
  241.     Case MsgClearWhiteBoard
  242.         picDraw.Cls
  243.     End Select
  244.     End With
  245. End Sub
  246.  
  247. Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean)
  248.     'VB requires that we must implement *every* member of this interface
  249. End Sub
  250.  
  251. Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean)
  252.     'VB requires that we must implement *every* member of this interface
  253. End Sub
  254.